home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / gnu_tile_forth.lha / tst / stacks.tst < prev    next >
Text File  |  1992-05-19  |  815b  |  44 lines
  1. .( Loading Stacks test...) cr
  2.  
  3. #include stacks.f83
  4.  
  5. stacks forth definitions
  6.  
  7.  
  8. .( 1: Create a small stack to test this library) cr
  9.  
  10. 3 STACK foo ( -- stack)
  11. foo .stack cr
  12.  
  13.  
  14. .( 2: Push elements until the stack is full) cr
  15.  
  16. foo ?full-stack . foo ?empty-stack . cr
  17. 10 foo push foo .stack cr
  18. foo ?full-stack . foo ?empty-stack . cr
  19. 11 foo push foo .stack cr
  20. foo ?full-stack . foo ?empty-stack . cr
  21. 12 foo push foo .stack cr
  22. foo ?full-stack . foo ?empty-stack . cr
  23. cr
  24.  
  25.  
  26. .( 3: Access and change the top of stack) cr
  27.  
  28. foo @ @ 1+ foo @ ! foo .stack cr
  29. cr
  30.  
  31.  
  32. .( 4: Pop elements until the stack is empty) cr
  33.  
  34. foo pop foo .stack cr drop 
  35. foo ?full-stack . foo ?empty-stack . cr
  36.  
  37. foo pop foo .stack cr drop 
  38. foo ?full-stack . foo ?empty-stack . cr
  39.  
  40. foo pop foo .stack cr drop 
  41. foo ?full-stack . foo ?empty-stack . cr
  42.  
  43. forth only
  44.